####################################
# Limitations of Stabilizing       #
# Effects of Fundamentalists       #
# Facing Positive Feedback Traders #
#                                  #
# Michael Heinrich Baumann,        #
# Michaela Baumann, and            #
# Alexander Erler                  #
#                                  #
# November 2019                    #
####################################

### market parameter settings

  # individual settings

  T <- 250 # Terminal time for the simulations
  fundamentalists <- T # Market with or without fundamentalists
  I0 <- 0.192 # Initial investment chartist
  K <- 2 # Feedback parameter
  p0 <- 1 # Initial price 
  f0 <- p0 # Initial fundamental value (ignored in markets without fundamentalists)
  M <- 1 # Scaling parameter 

  input <- list(terminal_time=T,feedback_param=K,scaling_param=M,init_price=p0,init_fund_value=f0,init_c=I0,fundamentalists=fundamentalists)
  
  # Settings used in the paper
  
  Fig4 <- list(terminal_time=250,feedback_param=2,scaling_param=1,init_price=1,init_fund_value=1,init_c=0.191,fundamentalists=F)
  Fig5 <- list(terminal_time=250,feedback_param=2,scaling_param=1,init_price=1,init_fund_value=1,init_c=0.192,fundamentalists=F)
  Fig6 <- list(terminal_time=250,feedback_param=2,scaling_param=1,init_price=1,init_fund_value=1,init_c=0.519,fundamentalists=T)
  Fig7 <- list(terminal_time=250,feedback_param=2,scaling_param=1,init_price=1,init_fund_value=1,init_c=0.521,fundamentalists=T)

### Function definitions  
  
  # Function simulating the market
  simulate_trade <- function(function_input){
  
    terminal_time <- function_input$terminal_time
    feedback_param <- function_input$feedback_param
    scaling_param <- function_input$scaling_param
    init_price <- function_input$init_price
    init_fund_value <- function_input$init_fund_value
    init_c <- function_input$init_c
    fundamentalists <- function_input$fundamentalists
    
    ### Initialize vectors for fundamental value and price
    # Fundamental value
    f <- rep(init_fund_value,terminal_time+1)
    # Price
    p <- rep(init_price,terminal_time+1)
    
    ### Initialize vectors for demands
    # Fundamentalists
    DF <- rep(0,terminal_time)
    # Chartists
    DC <- rep(init_c,terminal_time)
    
    ### Compute first value separately
    # Dependent on existence of fundamentalists
    if (fundamentalists==F){
      # Price
      p[2] <- init_price*exp(init_c/scaling_param)
    } else if (fundamentalists==T){
      # Demand fundamentalists
      DF[1] <- scaling_param*log(f[2]/p[1])
      # Price
      p[2] <- init_price*exp((init_c+DF[1])/scaling_param)
    }
  
    ### Loop over remaining points of time
    # Dependent on existence of fundamentalists
    if (fundamentalists==F){
      for (i in 2:terminal_time) {
    	  # Demand chartists (without fundamentalists)
    	  DC[i] <- feedback_param*(p[i]-p[i-1])/p[i-1]*sum(DC[1:(i-1)])
    	  # Price (without fundamentalists)
    	  p[i+1] <- p[i]*exp(DC[i]/scaling_param)
    	  # Note for output
    	  note <- "market without fundamentalists"
      }
    } else if (fundamentalists==T){
      for (i in 2:terminal_time){
    	  # Demand fundamentalists
    	  DF[i] <- scaling_param*log(f[i+1]/p[i])
    	  # Demand chartists (with fundamentalists)
    	  DC[i] <- feedback_param*(p[i]-p[i-1])/p[i-1]*sum(DC[1:(i-1)])
    	  # Price (with fundamentalists)
    	  p[i+1] <- p[i]*exp((DC[i]+DF[i])/scaling_param)
    	  # Note for output
    	  note <- "market with fundamentalists"
    	}
    }
    
    return(list(price=p,demand_c=DC,demand_f=DF,note=note))
    
  }
  
  # Function for plotting
  plot_simulation <- function(price, demand_c, demand_f=NULL,max_display_time,ylim){
  
    if(max_display_time>length(price)){
      print("display time too long")
      break
    }
    
    if (is.null(demand_f)){
      # Plotting instructions
      p <- plot(price[1:max_display_time],type='l',ylim=ylim,xlab='t',ylab='p (solid), D^C (dashed)',lwd=2)
      lines(demand_c[1:max_display_time],lty=2,lwd=2)
      lines(rep(0,max_display_time),lty=1)
    }else if (!is.null(demand_f)){
      # Plotting instructions
      p <- plot(price[1:max_display_time],type='l',ylim=ylim,xlab='t',ylab='p (solid), D^C (dashed), D^F (dotted)',lwd=2)
      lines(demand_c[1:max_display_time],lty=2,lwd=2)
      lines(demand_f[1:max_display_time],lty=3,lwd=2)
      lines(rep(0,max_display_time),lty=1)
    }
  
    return(list(plot=p,note="Have a look at the plot"))
    
  }
  
  # Function for tables
  draw_table <- function(demand_c,table_length){
    DC <- demand_c
    M <- as.data.frame(matrix(c(cumsum(DC[1:table_length]),DC[1:table_length],c(0,diff(DC[1:table_length])),c(0,0,diff(diff(DC[1:table_length])))),table_length,ncol=4))
    colnames(M) <- c("cumsum","demand_chartist","first_diff","second_diff")
    
    return(list(difference_table=M))
  }

### Function calls
  
### Market simulation

sim <- simulate_trade(function_input=input) # Alternatives: Fig4, Fig5, Fig6, Fig7, input
# Outputs
#sim$price # price process
#sim$demand_c # demand chartists
#sim$demand_f # demand fundamentalists (if active)
#sim$note # note: market with/without fundamentalists

### Plots

# Plot function call without fundamentalists
plot_simulation(price = sim$price,demand_c = sim$demand_c,max_display_time = T,ylim = c(0,5))
# Plot function call with fundamentalists
plot_simulation(price = sim$price,demand_c = sim$demand_c,demand_f = sim$demand_f,max_display_time = 25,ylim = c(-5,5))

### Tables

# Paper Table 1 (dependent on market simulation)
draw_table(demand_c=sim$demand_c,table_length=20)
# Paper Table 2 (dependent on market simulation)
draw_table(demand_c=sim$demand_c,table_length=100)
